﻿Imports Microsoft.Win32
Imports System.IO

'Public Class Util

'    Public Function GetINIstring(ByVal strKey As String, ByVal strSection As String, MPFfile As String) As String
'        Dim strValue As String

'        strValue = Space(1024)
'        GetPrivateProfileString(strSection, strKey, "Not-Found", strValue, 4096, MPFfile)
'        strValue = Mid(strValue, 1, Len(strValue) - 1)
'        strValue = Trim(Left(strValue, Len(Trim(strValue)) - 1))
'        strValue = Trim(strValue)
'        'WriteLog("CONFIG: ""[" & strSection & "]::" & strKey & "=""" & strValue & """")

'        GetINIstring = strValue
'    End Function


'    Public Declare Ansi Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" _
'     (ByVal lpApplicationName As String, _
'     ByVal lpKeyName As String, ByVal lpDefault As String, _
'     ByVal lpReturnedString As String, _
'     ByVal nSize As Integer, ByVal lpFileName As String) _
'     As Integer

'    Private Declare Ansi Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" _
'           (ByVal lpApplicationName As String, _
'           ByVal lpKeyName As String, ByVal lpString As String, _
'           ByVal lpFileName As String) As Integer




'End Class



Public Class INIUtil

    ' API functions
    Private Declare Ansi Function GetPrivateProfileString _
      Lib "kernel32.dll" Alias "GetPrivateProfileStringA" _
      (ByVal lpApplicationName As String, _
      ByVal lpKeyName As String, ByVal lpDefault As String, _
      ByVal lpReturnedString As System.Text.StringBuilder, _
      ByVal nSize As Integer, ByVal lpFileName As String) _
      As Integer
    Private Declare Ansi Function WritePrivateProfileString _
      Lib "kernel32.dll" Alias "WritePrivateProfileStringA" _
      (ByVal lpApplicationName As String, _
      ByVal lpKeyName As String, ByVal lpString As String, _
      ByVal lpFileName As String) As Integer
    Private Declare Ansi Function GetPrivateProfileInt _
      Lib "kernel32.dll" Alias "GetPrivateProfileIntA" _
      (ByVal lpApplicationName As String, _
      ByVal lpKeyName As String, ByVal nDefault As Integer, _
      ByVal lpFileName As String) As Integer
    Private Declare Ansi Function FlushPrivateProfileString _
      Lib "kernel32.dll" Alias "WritePrivateProfileStringA" _
      (ByVal lpApplicationName As Integer, _
      ByVal lpKeyName As Integer, ByVal lpString As Integer, _
      ByVal lpFileName As String) As Integer

    Dim strFilename As String = ""

    ' Constructor, accepting a filename
    'Public Sub New(ByVal Filename As String)
    '   strFilename = Filename
    'End Sub

    ' Read-only filename property
    Public Property FileName() As String
        Get
            Return strFilename
        End Get

        Set(Filename As String)
            If File.Exists(Filename) = False Then
                File.Create(Filename)
            Else
                strFilename = Filename
            End If
        End Set
    End Property

    Public Function GetString(ByVal Section As String, ByVal Key As String, ByVal [Default] As String) As String
        GetString = ""
        Dim intCharCount As Integer
        Dim objResult As New System.Text.StringBuilder(256)
        intCharCount = GetPrivateProfileString(Section, Key, _
           [Default], objResult, objResult.Capacity, strFilename)
        If intCharCount > 0 Then GetString = Left(objResult.ToString, intCharCount)
    End Function

    Public Function GetInteger(ByVal Section As String, ByVal Key As String, ByVal [Default] As Integer) As Integer
        ' Returns an integer from your INI file
        Return GetPrivateProfileInt(Section, Key, [Default], strFilename)
    End Function

    Public Function GetBoolean(ByVal Section As String, ByVal Key As String, ByVal [Default] As Boolean) As Boolean
        ' Returns a boolean from your INI file
        Return (GetPrivateProfileInt(Section, Key, CInt([Default]), strFilename) = 1)
    End Function

    Public Sub WriteString(ByVal Section As String, ByVal Key As String, ByVal Value As String)
        ' Writes a string to your INI file
        WritePrivateProfileString(Section, Key, Value, strFilename)
        Flush()
    End Sub

    Public Sub WriteInteger(ByVal Section As String, ByVal Key As String, ByVal Value As Integer)
        ' Writes an integer to your INI file
        WriteString(Section, Key, CStr(Value))
        Flush()
    End Sub

    Public Sub WriteBoolean(ByVal Section As String, ByVal Key As String, ByVal Value As Boolean)
        ' Writes a boolean to your INI file
        WriteString(Section, Key, CStr(CInt(Value)))
        Flush()
    End Sub

    Private Sub Flush()
        ' Stores all the cached changes to your INI file
        FlushPrivateProfileString(0, 0, 0, strFilename)
    End Sub

End Class



Public Class RegistryUtil

    ' Definiert alle möglichen Root-Schlüssel
    Public Enum RegistryPossibleRoots
        HKEY_CLASSES_ROOT = 0
        HKEY_CURRENT_CONFIG = 1
        HKEY_CURRENT_USER = 2
        'HKEY_DYNDATA = 3
        HKEY_LOCALE_MACHINE = 4
        HKEY_PERFORMANCE_DATA = 5
        HKEY_USERS = 6
    End Enum

    ' Auslesen des entspr. Registry-Keys
    Private Function GetRegKey(ByVal lngRoot As RegistryPossibleRoots) As RegistryKey
        On Error GoTo myErr
        GetRegKey = Registry.CurrentUser

        Select Case lngRoot
            Case RegistryPossibleRoots.HKEY_CLASSES_ROOT
                GetRegKey = Registry.ClassesRoot
            Case RegistryPossibleRoots.HKEY_CURRENT_CONFIG
                GetRegKey = Registry.CurrentConfig
            Case RegistryPossibleRoots.HKEY_CURRENT_USER
                GetRegKey = Registry.CurrentUser

                'Case RegistryPossibleRoots.HKEY_DYNDATA
                '   GetRegKey = Registry.DynData
            Case RegistryPossibleRoots.HKEY_LOCALE_MACHINE
                GetRegKey = Registry.LocalMachine
            Case RegistryPossibleRoots.HKEY_PERFORMANCE_DATA
                GetRegKey = Registry.PerformanceData
            Case RegistryPossibleRoots.HKEY_USERS
                GetRegKey = Registry.Users
        End Select

        Exit Function

myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        GetRegKey = Nothing
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Prüfen, ob Schlüssel existiert
    Public Function DoesKeyExist( _
    ByVal lngRootKey As RegistryPossibleRoots, _
    ByVal strKey As String) As Boolean
        Dim objRegKey As RegistryKey
        Dim bOK As Boolean

        On Error GoTo myErr

        objRegKey = GetRegKey(lngRootKey)

        objRegKey = objRegKey.OpenSubKey(strKey, False)

        If objRegKey Is Nothing Then
            bOK = False
        Else
            bOK = True
        End If

        If Not objRegKey Is Nothing Then
            objRegKey.Close()
            objRegKey = Nothing
        End If
        DoesKeyExist = bOK
        Exit Function

myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        objRegKey.Close()
        objRegKey = Nothing
        DoesKeyExist = bOK
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Schlüssel(-pfad) anlegen
    Public Function CreateKey(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String) As Boolean
        Dim objRegKey As RegistryKey

        On Error GoTo myErr

        objRegKey = GetRegKey(lngrootkey)

        objRegKey = objRegKey.CreateSubKey(strKey)

        If objRegKey Is Nothing Then
            CreateKey = False
        Else
            CreateKey = True
        End If
        objRegKey.Close()
        objRegKey = Nothing

        Exit Function

myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next

        '		if not objRegKey is nothing then
        objRegKey.Close()
        objRegKey = Nothing
        '		end if
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Schlüssel löschen
    Public Function DeleteKey(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String, _
    Optional ByVal bRecursive As Boolean = False) As Boolean
        Dim objRegKey As RegistryKey
        Dim bOK As Boolean

        On Error GoTo myErr

        bOK = True
        objRegKey = GetRegKey(lngrootkey)

        If bRecursive Then
            objRegKey.DeleteSubKeyTree(strKey)
        Else
            objRegKey.DeleteSubKey(strKey)
        End If

        objRegKey.Close()
        objRegKey = Nothing
        DeleteKey = bOK
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        objRegKey.Close()
        objRegKey = Nothing
        DeleteKey = bOK
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Registry-Wert abfragen (3 Funktionen)
    ' =====================================
    ' Registry-Wert abfragen (String)
    Public Function QueryValue(ByVal lngrootkey As RegistryPossibleRoots, ByVal strKey As String, ByVal strValName As String, ByVal objDefault As String) As String

        Dim objRegKey As RegistryKey
        Dim strType As Long
        Dim strRet As String

        On Error GoTo myErr

        objRegKey = GetRegKey(lngrootkey)
        objRegKey = objRegKey.OpenSubKey(strKey)

        strRet = CStr(objRegKey.GetValue(strValName, objDefault))
        QueryValue = strRet

        strRet = ""
        objRegKey.Close()
        objRegKey = Nothing
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        strRet = Nothing
        objRegKey.Close()
        objRegKey = Nothing
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Registry-Wert abfragen (Byte-Array => Binary)
    Public Function QueryValue(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String, _
    ByVal strValName As String, _
    ByVal objDefault() As Byte) As Byte()

        Dim objRegKey As RegistryKey
        Dim strType As Long
        Dim arrRet() As Byte

        On Error GoTo myErr

        objRegKey = GetRegKey(lngrootkey)
        objRegKey = objRegKey.OpenSubKey(strKey)

        arrRet = CType(objRegKey.GetValue(strValName, objDefault), Byte())
        QueryValue = arrRet

        arrRet = Nothing
        objRegKey.Close()
        objRegKey = Nothing
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        arrRet = Nothing
        objRegKey.Close()
        objRegKey = Nothing
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Registry-Wert abfragen (Integer => DWORD)
    Public Function QueryValue(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String, _
    ByVal strValName As String, _
    ByVal objDefault As Integer) As Integer

        Dim objRegKey As RegistryKey
        Dim strType As Long
        Dim intRet As Integer

        On Error GoTo myErr

        objRegKey = GetRegKey(lngrootkey)
        objRegKey = objRegKey.OpenSubKey(strKey)

        intRet = CInt(objRegKey.GetValue(strValName, objDefault))
        QueryValue = intRet

        objRegKey.Close()
        objRegKey = Nothing
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        intRet = Nothing
        objRegKey.Close()
        objRegKey = Nothing
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Registry-Wert anlegen (Schlüssel muss existieren) => String
    Public Function CreateValue(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String, _
    ByVal strValName As String, _
    ByVal objVal As String) As Boolean

        Dim objRegKey As RegistryKey
        Dim strType As Long
        Dim objRet As Object
        Dim bOK As Boolean

        On Error GoTo myErr

        bOK = False

        objRegKey = GetRegKey(lngrootkey)
        objRegKey = objRegKey.OpenSubKey(strKey, True)

        If Not objRegKey Is Nothing Then
            objRegKey.SetValue(strValName, objVal)
            objRegKey.Flush()
            bOK = True
            objRegKey.Close()
            objRegKey = Nothing
        Else
            bOK = False
        End If

        CreateValue = bOK
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        objRegKey.Close()
        objRegKey = Nothing
        CreateValue = bOK
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Registry-Wert anlegen (Schlüssel muss existieren) => Byte-Array => Binary
    Public Function CreateValue(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String, _
    ByVal strValName As String, _
    ByVal objVal() As Byte) As Boolean

        Dim objRegKey As RegistryKey
        Dim strType As Long
        Dim objRet As Object
        Dim bOK As Boolean

        On Error GoTo myErr

        bOK = False

        objRegKey = GetRegKey(lngrootkey)
        objRegKey = objRegKey.OpenSubKey(strKey, True)

        If Not objRegKey Is Nothing Then
            objRegKey.SetValue(strValName, objVal)
            objRegKey.Flush()
            bOK = True
            objRegKey.Close()
            objRegKey = Nothing
        Else
            bOK = False
        End If

        CreateValue = bOK
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        objRegKey.Close()
        objRegKey = Nothing
        CreateValue = bOK
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Registry-Wert anlegen (Schlüssel muss existieren) => Integer => DWORD
    Public Function CreateValue(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String, _
    ByVal strValName As String, _
    ByVal objVal As Integer) As Boolean

        Dim objRegKey As RegistryKey
        Dim strType As Long
        Dim objRet As Object
        Dim bOK As Boolean

        On Error GoTo myErr

        bOK = False

        objRegKey = GetRegKey(lngrootkey)
        objRegKey = objRegKey.OpenSubKey(strKey, True)

        If Not objRegKey Is Nothing Then
            objRegKey.SetValue(strValName, objVal)
            objRegKey.Flush()
            bOK = True
            objRegKey.Close()
            objRegKey = Nothing
        Else
            bOK = False
        End If

        CreateValue = bOK
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        objRegKey.Close()
        objRegKey = Nothing
        CreateValue = bOK
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function

    ' Registry-Wert löschen (Schlüssel muss existieren) 
    Public Function DeleteValue(ByVal lngrootkey As RegistryPossibleRoots, _
    ByVal strKey As String, _
    ByVal strValName As String) As Boolean

        Dim objRegKey As RegistryKey
        Dim strType As Long
        Dim objRet As Object
        Dim bOK As Boolean

        On Error GoTo myErr

        bOK = False

        objRegKey = GetRegKey(lngrootkey)
        objRegKey = objRegKey.OpenSubKey(strKey, True)

        If Not objRegKey Is Nothing Then
            objRegKey.DeleteValue(strValName)
            objRegKey.Flush()
            bOK = True
            objRegKey.Close()
            objRegKey = Nothing
        Else
            bOK = False
        End If

        DeleteValue = bOK
        Exit Function
myErr:
        Dim lngErrNr As Integer
        Dim strErrSrc As String
        Dim strErrDesc As String
        lngErrNr = Err.Number
        strErrSrc = Err.Source
        strErrDesc = Err.Description

        On Error Resume Next
        objRegKey.Close()
        objRegKey = Nothing
        DeleteValue = bOK
        Err.Clear()
        Err.Raise(lngErrNr, strErrSrc, strErrDesc)
    End Function
End Class
